home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / menubut.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  13.3 KB  |  353 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test menubuttons in Tk.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # SCCS: @(#) menubut.test 1.26 97/07/31 10:08:50
  11.  
  12. # XXX This test file is woefully incomplete right now.  If any part
  13. # XXX of a procedure has tests then the whole procedure has tests,
  14. # XXX but many procedures have no tests.
  15.  
  16. if {[lsearch [image types] test] < 0} {
  17.     puts "This application hasn't been compiled with the \"test\" image"
  18.     puts "type, so I can't run this test.  Are you sure you're using"
  19.     puts "tktest instead of wish?"
  20.     return
  21. }
  22.  
  23. if {[info procs test] != "test"} {
  24.     source defs
  25. }
  26.  
  27. foreach i [winfo children .] {
  28.     destroy $i
  29. }
  30. wm geometry . {}
  31. raise .
  32.  
  33. # Create entries in the option database to be sure that geometry options
  34. # like border width have predictable values.
  35.  
  36. option add *Menubutton.borderWidth 2
  37. option add *Menubutton.highlightThickness 2
  38. option add *Menubutton.font {Helvetica -12 bold}
  39. option add *Button.borderWidth 2
  40. option add *Button.highlightThickness 2
  41. option add *Button.font {Helvetica -12 bold}
  42.  
  43. eval image delete [image names]
  44. image create test image1
  45. menubutton .mb -text "Test"
  46. pack .mb
  47. update
  48. set i 1
  49. foreach test {
  50.     {-activebackground #012345 #012345 non-existent
  51.         {unknown color name "non-existent"}}
  52.     {-activeforeground #ff0000 #ff0000 non-existent
  53.         {unknown color name "non-existent"}}
  54.     {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
  55.     {-background #ff0000 #ff0000 non-existent
  56.         {unknown color name "non-existent"}}
  57.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  58.     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
  59.     {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
  60.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  61.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  62.     {-direction below below badValue {bad direction value "badValue": must be above, below, left, right, or flush}}
  63.     {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
  64.     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
  65.     {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
  66.     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
  67.     {-height 18 18 20.0 {expected integer but got "20.0"}}
  68.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  69.     {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
  70.     {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
  71.     {-image image1 image1 bogus {image "bogus" doesn't exist}}
  72.     {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
  73.     {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
  74.     {-menu "any old string" "any old string" {} {}}
  75.     {-padx 12 12 420x {bad screen distance "420x"}}
  76.     {-pady 12 12 420x {bad screen distance "420x"}}
  77.     {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
  78.     {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
  79.     {-takefocus "any string" "any string" {} {}}
  80.     {-text "Sample text" {Sample text} {} {}}
  81.     {-textvariable i i {} {}}
  82.     {-underline 5 5 3p {expected integer but got "3p"}}
  83.     {-width 402 402 3p {expected integer but got "3p"}}
  84.     {-wraplength 100 100 6x {bad screen distance "6x"}}
  85. } {
  86.     set name [lindex $test 0]
  87.     test menubutton-1.$i {configuration options} {
  88.     .mb configure $name [lindex $test 1]
  89.     lindex [.mb configure $name] 4
  90.     } [lindex $test 2]
  91.     incr i
  92.     if {[lindex $test 3] != ""} {
  93.     test menubutton-1.$i {configuration options} {
  94.         list [catch {.mb configure $name [lindex $test 3]} msg] $msg
  95.     } [list 1 [lindex $test 4]]
  96.     }
  97.     .mb configure $name [lindex [.mb configure $name] 3]
  98.     incr i
  99. }
  100.  
  101. test menubutton-2.1 {Tk_MenubuttonCmd procedure} {
  102.     list [catch {menubutton} msg] $msg
  103. } {1 {wrong # args: should be "menubutton pathName ?options?"}}
  104. test menubutton-2.2 {Tk_MenubuttonCmd procedure} {
  105.     list [catch {menubutton foo} msg] $msg
  106. } {1 {bad window path name "foo"}}
  107. test menubutton-2.3 {Tk_MenubuttonCmd procedure} {
  108.     catch {destroy .mb}
  109.     menubutton .mb
  110.     winfo class .mb
  111. } {Menubutton}
  112. test menubutton-2.4 {Tk_ButtonCmd procedure} {
  113.     catch {destroy .mb}
  114.     list [catch {menubutton .mb -gorp foo} msg] $msg [winfo exists .mb]
  115. } {1 {unknown option "-gorp"} 0}
  116.  
  117. catch {destroy .mb}
  118. menubutton .mb -text "Test Menu"
  119. pack .mb
  120. test menubutton-3.1 {MenuButtonWidgetCmd procedure} {
  121.     list [catch {.mb} msg] $msg
  122. } {1 {wrong # args: should be ".mb option ?arg arg ...?"}}
  123. test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} {
  124.     list [catch {.mb c} msg] $msg
  125. } {1 {bad option "c": must be cget or configure}}
  126. test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} {
  127.     list [catch {.mb cget} msg] $msg
  128. } {1 {wrong # args: should be ".mb cget option"}}
  129. test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} {
  130.     list [catch {.mb cget a b} msg] $msg
  131. } {1 {wrong # args: should be ".mb cget option"}}
  132. test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} {
  133.     list [catch {.mb cget -gorp} msg] $msg
  134. } {1 {unknown option "-gorp"}}
  135. test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} {
  136.     .mb configure -highlightthickness 3
  137.     .mb cget -highlightthickness
  138. } {3}
  139. test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} {
  140.     llength [.mb configure]
  141. } {32}
  142. test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} {
  143.     list [catch {.mb configure -gorp} msg] $msg
  144. } {1 {unknown option "-gorp"}}
  145. test menubutton-3.9 {ButtonWidgetCmd procedure, "configure" option} {
  146.     list [catch {.mb co -bg #ffffff -fg} msg] $msg
  147. } {1 {value for "-fg" missing}}
  148. test menubutton-3.10 {ButtonWidgetCmd procedure, "configure" option} {
  149.     .mb configure -fg #123456
  150.     .mb configure -bg #654321
  151.     lindex [.mb configure -fg] 4
  152. } {#123456}
  153. test menubutton-3.11 {ButtonWidgetCmd procedure, "configure" option} {
  154.     list [catch {.mb foobar} msg] $msg
  155. } {1 {bad option "foobar": must be cget or configure}}
  156.  
  157. # XXX Need to add tests for several procedures here.   The tests for   XXX
  158. # XXX ConfigureMenuButton aren't complete either.                      XXX
  159.  
  160. test menubutton-4.1 {ConfigureMenuButton procedure} {
  161.     catch {destroy .mb1}
  162.     button .mb1 -text "Menubutton 1"
  163.     list [catch {.mb1 configure -width 1i} msg] $msg $errorInfo
  164. } {1 {expected integer but got "1i"} {expected integer but got "1i"
  165.     (processing -width option)
  166.     invoked from within
  167. ".mb1 configure -width 1i"}}
  168. test menubutton-4.2 {ConfigureMenuButton procedure} {
  169.     catch {destroy .mb1}
  170.     button .mb1 -text "Menubutton 1"
  171.     list [catch {.mb1 configure -height 0.5c} msg] $msg $errorInfo
  172. } {1 {expected integer but got "0.5c"} {expected integer but got "0.5c"
  173.     (processing -height option)
  174.     invoked from within
  175. ".mb1 configure -height 0.5c"}}
  176. test menubutton-4.3 {ConfigureMenuButton procedure} {
  177.     catch {destroy .mb1}
  178.     button .mb1 -bitmap questhead
  179.     list [catch {.mb1 configure -width abc} msg] $msg $errorInfo
  180. } {1 {bad screen distance "abc"} {bad screen distance "abc"
  181.     (processing -width option)
  182.     invoked from within
  183. ".mb1 configure -width abc"}}
  184. test menubutton-4.4 {ConfigureMenuButton procedure} {
  185.     catch {destroy .mb1}
  186.     eval image delete [image names]
  187.     image create test image1
  188.     button .mb1 -image image1
  189.     list [catch {.mb1 configure -height 0.5x} msg] $msg $errorInfo
  190. } {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
  191.     (processing -height option)
  192.     invoked from within
  193. ".mb1 configure -height 0.5x"}}
  194. test menubutton-4.5 {ConfigureMenuButton procedure} {fonts} {
  195.     catch {destroy .mb1}
  196.     button .mb1 -text "Sample text" -width 10 -height 2
  197.     pack .mb1
  198.     set result "[winfo reqwidth .mb1] [winfo reqheight .mb1]"
  199.     .mb1 configure -bitmap questhead
  200.     lappend result [winfo reqwidth .mb1] [winfo reqheight .mb1]
  201. } {102 46 20 12}
  202. test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} {
  203.     catch {destroy .mb}
  204.     menubutton .mb -text "Test"
  205.     list [catch {.mb configure -direction badValue} msg] $msg \
  206.     [.mb cget -direction] [destroy .mb]
  207. } {1 {bad direction value "badValue": must be above, below, left, right, or flush} below {}}
  208.  
  209. # XXX Need to add tests for several procedures here. XXX
  210.  
  211. test menubutton-5.1 {MenuButtonEventProc procedure} {
  212.     eval destroy [winfo children .]
  213.     menubutton .mb1 -bg #543210
  214.     rename .mb1 .mb2
  215.     set x {}
  216.     lappend x [winfo children .]
  217.     lappend x [.mb2 cget -bg]
  218.     destroy .mb1
  219.     lappend x [info command .mb*] [winfo children .]
  220. } {.mb1 #543210 {} {}}
  221.  
  222. test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} {
  223.     eval destroy [winfo children .]
  224.     menubutton .mb1
  225.     rename .mb1 {}
  226.     list [info command .mb*] [winfo children .]
  227. } {{} {}}
  228.  
  229. test menubutton-7.1 {ComputeMenuButtonGeometry procedure} {
  230.     catch {destroy .mb}
  231.     menubutton .mb -image image1 -bd 4 -highlightthickness 0
  232.     pack .mb
  233.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  234. } {38 23}
  235. test menubutton-7.2 {ComputeMenuButtonGeometry procedure} {
  236.     catch {destroy .mb}
  237.     menubutton .mb -image image1 -bd 1 -highlightthickness 2
  238.     pack .mb
  239.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  240. } {36 21}
  241. test menubutton-7.3 {ComputeMenuButtonGeometry procedure} {
  242.     catch {destroy .mb}
  243.     menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5
  244.     pack .mb
  245.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  246. } {34 19}
  247. test menubutton-7.4 {ComputeMenuButtonGeometry procedure} {
  248.     catch {destroy .mb}
  249.     menubutton .mb -image image1 -bd 2 -relief raised -width 40 \
  250.         -highlightthickness 2
  251.     pack .mb
  252.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  253. } {48 23}
  254. test menubutton-7.5 {ComputeMenuButtonGeometry procedure} {
  255.     catch {destroy .mb}
  256.     menubutton .mb -image image1 -bd 2 -relief raised -height 30 \
  257.         -highlightthickness 2
  258.     pack .mb
  259.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  260. } {38 38}
  261. test menubutton-7.6 {ComputeMenuButtonGeometry procedure} {
  262.     catch {destroy .mb}
  263.     menubutton .mb -bitmap question -bd 2 -relief raised \
  264.         -highlightthickness 2
  265.     pack .mb
  266.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  267. } {25 35}
  268. test menubutton-7.7 {ComputeMenuButtonGeometry procedure} {
  269.     catch {destroy .mb}
  270.     menubutton .mb -bitmap question -bd 2 -relief raised -width 40 \
  271.         -highlightthickness 1
  272.     pack .mb
  273.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  274. } {46 33}
  275. test menubutton-7.8 {ComputeMenuButtonGeometry procedure} {
  276.     catch {destroy .mb}
  277.     menubutton .mb -bitmap question -bd 2 -relief raised -height 50 \
  278.         -highlightthickness 1
  279.     pack .mb
  280.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  281. } {23 56}
  282. test menubutton-7.9 {ComputeMenuButtonGeometry procedure} {fonts} {
  283.     catch {destroy .mb}
  284.     menubutton .mb -text String -bd 2 -relief raised -padx 0 -pady 0 \
  285.         -highlightthickness 1
  286.     pack .mb
  287.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  288. } {42 20}
  289. test menubutton-7.10 {ComputeMenuButtonGeometry procedure} {fonts} {
  290.     catch {destroy .mb}
  291.     menubutton .mb -text String -bd 2 -relief raised -width 20 \
  292.         -padx 0 -pady 0 -highlightthickness 1
  293.     pack .mb
  294.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  295. } {146 20}
  296. test menubutton-7.11 {ComputeMenuButtonGeometry procedure} {fonts} {
  297.     catch {destroy .mb}
  298.     menubutton .mb -text String -bd 2 -relief raised -height 2 \
  299.         -padx 0 -pady 0 -highlightthickness 1
  300.     pack .mb
  301.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  302. } {42 34}
  303. test menubutton-7.12 {ComputeMenuButtonGeometry procedure} {fonts} {
  304.     catch {destroy .mb}
  305.     menubutton .mb -text String -bd 2 -relief raised -padx 10 -pady 5 \
  306.         -highlightthickness 1
  307.     pack .mb
  308.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  309. } {62 30}
  310. test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} {
  311.     catch {destroy .mb}
  312.     menubutton .mb -text String -bd 2 -relief raised \
  313.         -highlightthickness 1 -indicatoron 1
  314.     pack .mb
  315.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  316. } {78 28}
  317. test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} {
  318.     # The following test is non-portable because the indicator's pixel
  319.     # size varies to maintain constant absolute size.
  320.  
  321.     catch {destroy .mb}
  322.     menubutton .mb -image image1 -bd 2 -relief raised \
  323.         -highlightthickness 2 -indicatoron 1
  324.     pack .mb
  325.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  326. } {64 23}
  327. test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pc nonPortable} {
  328.     # The following test is non-portable because the indicator's pixel
  329.     # size varies to maintain constant absolute size.
  330.  
  331.     catch {destroy .mb}
  332.     menubutton .mb -image image1 -bd 2 -relief raised \
  333.         -highlightthickness 2 -indicatoron 1
  334.     pack .mb
  335.     list [winfo reqwidth .mb] [winfo reqheight .mb]
  336. } {65 23}
  337.  
  338. set l [interp hidden]
  339. eval destroy [winfo children .]
  340.  
  341. test menubutton-8.1 {menubutton vs hidden commands} {
  342.     catch {destroy .mb}
  343.     menubutton .mb
  344.     interp hide {} .mb
  345.     destroy .mb
  346.     list [winfo children .] [interp hidden]
  347. } [list {} $l]
  348.  
  349. eval image delete [image names]
  350. eval destroy [winfo children .]
  351. option clear
  352.  
  353.